perm filename S2Z.F4[P11,LCS] blob sn#400673 filedate 1979-01-30 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE READIT
C00025 00003	101	N=INP(ML)
C00049 00004	1106	KTMP=1
C00057 ENDMK
C⊗;
	SUBROUTINE READIT
C11	DOUBLE PRECISION J,ITEMP,IRUN,IEDIT,IPRECE,INSER,IPLAY,
C11	1 ISECTI,IEND,IFINI,JEND
	COMMON /PCIP/ PCH(27,102),IPT(27,101) /ERRFLG/ERRFLG
	COMMON/P/P(1) /PL/PL(1) /COPY/NUMP

	COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,JED  /NAMES/NA(100),LETRS(27),JNAM(27)
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
	COMMON /VV/LIMIT,V(1) /A/ROFF(27),NP(27)
	1,RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
	1 ,INVIS(27)
	DIMENSION IV(1),LIST(78),JNP(80),KNP(15)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
	COMMON J,L,CNT(27),BT,MK,SUB,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,INSNUM,NNUM,JJ,JA,ISUB,NFLG,
	1 IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (VX1,VX(1)),(KNP,JNP,INP1,INP(1)),(IPP,ISCA(2))
	1 ,(ISS,ISCA(9)),(ITT,ISCA(11)),(ICC,ISCA(1)),(NINE,IDAT(10))
	1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
	1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
	1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8)),(IZERO,IDAT(1))
	DATA KSLA/'/'/,III/'I'/,IEN/'N'/,ITMPO/'TEMP'/
	1,J80/'80'/,JA1/'A1'/,LRTPAR/')'/,LY/'Y'/,LR/'R'/,LU/'U'/
	1,ICOM/','/,IEXP/'!'/,INUM/'#'/,IANPRS/'&'/,IDBLQ/'"'/,
	1ILESS/'<'/,IQUES/'?'/,IPERC/'%'/,LFTPAR/'('/,LDOL/'$'/,
	1MINUS/'-'/,IEM/'M'/,IEL/'L'/,IRUN/'RUN;'/,INSER/'INSE'/
	1,IPRECE/'PREC'/,IEDIT/'EDIT'/,IPLAY/'PLAY'/,IEND/'END '/,
	1ISECTI/'SECT'/,IFINI/'FINI'/,IAT/'@'/,LQ/'Q'/,IASTR/'*'/,
	1ASTR/'*'/,JEND/'END;'/
C   *************** READS INPUT  ***********************

	ERRFLG=0
	KIMIT=LIMIT-100
C  FOR WARNING ABOUT BUFFER OVERLOAD (LABEL 1774)
	ICHD=0
2308	IF(ITYP)GO TO 2127
2200	FORMAT(' TYPE INST NAME, ETC'/)
23081	TYPE 2200 
	ACCEPT 77732,JNP
CKL	IF(JNP(1).EQ.'	')GO TO 23081
CHECK FOR TAB
77732	FORMAT(80A1)
	IF(JED)CALL COLTTY(JNP,21)
CKL	JFM(4)='80A1)'
	JFM(4)='80A1)'
C  PUTS ON LPT AND TTY
	GO TO 1074
2127	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.

C******441	JFM(4)=J80A1  
	IF(LN.EQ.0)GO TO 1074
CKL	JFM(1)=' (I,A'
	JFM(1)=' (I,A'
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,LN,J,JNP
	GO TO 4127
CKL 1074	IF(INP1.EQ.IBLA.OR.INP1.EQ.32347529280)GO TO 2308
1074	IF(INP1.EQ.IBLA.OR.INP1.EQ.ILESS)GO TO 2308
C  ABOVE FOR COMMENTS 
CKL	JFM(1)='   (A'
	JFM(1)='   (A'
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,J,JNP
4127	IF(JED)GO TO 41271
	IF(K.EQ.LY)GO TO 41271
C  K CHECK IS TO PASS AFTER RETYPING
2202	FORMAT(' RETYPE LINE?'/)
	TYPE 2202 
	ACCEPT 77732,K
CKL	CALL LO2UP(K)
	IF(K.EQ.LY)GO TO 23081
	IF(K.EQ.IG)JED=-1


41271	IF(J.EQ.IBLA)GO TO 2308
CHECKS FOR SPACE(IBLA)
CKL	CALL LO2UP(J)
C MAKE SURE INST NAME, ETC. IS UPPER CASE.
	LLETRS=MLX
C  LETRS FOR NAME CHANGE FEATURE AT 104
	MLX=1
	IZ=0
	JA=-1
	ISUB=4
	CALL CLEAN(LEND)
C  CLEANS OUT = AND , AND FINDS LINE LENGTH.
	ALL=1.
	VX1=0
	VX2=0
	VX3=0
	INSNUM=-1
	K=0
	JRSTA=0
	IOFSET=0
C** IOFSET IS FOR 'CONTINUATION PARAMETERS' - SO INPUT P'S MATCH INST.
C** CAUTION!!!  ANY 'OFFSET' PARAMS THAT ARE REFERRED TO AFTER AN 'END'
C** MUST USE THE PROPER INTERNAL NUMB. OF SCORE, NOT THE INST. PARAM!!!!!
	IF(V(I-1).NE.-9900.-BY)GO TO 364
	BY=-1.
	I=I-1
364	DO 361 JD=1,LEND
	N=INP(JD)
	IF(N.NE.LR)GO TO 361
C  LOOKS FOR 'RESTART'
	DO 3611 M=JD,LEND
	KL=INP(M)
	IF(KL.EQ.IBLA)GO TO 3631
	IF(KL.EQ.ISEMI)GO TO 3631
3611	INP(M)=IBLA
C   CHANGES 'RESTART' TO BLANKS
3631	DO 363 N=1,NINS
	IF(J.NE.INST(N))GO TO 363
	IQ(N)=-1
C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
	JRSTA=J
	GO TO 362
363	CONTINUE
361	IF(N.EQ.ISEMI)GO TO 6773
6773	K=K+1
	IF(K.GT.NINS)GO TO 36
	IF(INST(K).NE.J)GO TO 6773
	IF(IQ(K).EQ.-1)GO TO 6773
C   FINDS CORRECT INST NUM.  PASSES RESTARTED INSTS.
	INSNUM=K
	GO TO 1773
36	IF(J.EQ.IRUN)CALL RUNIT
CKL 36	IF(J.EQ.'RUN;')GO TO 197
CKL	IF(J.NE.'RUN')GO TO 97
CKL197	CALL RUNIT
97	IF(J.EQ.INSER)GO TO 397
	IF(J.EQ.IPRECE)GO TO 397
	IF(J.NE.IEDIT)GO TO 297
CKL97	IF(J.EQ.'INSER')GO TO 397
CKL	IF(J.EQ.'PRECE')GO TO 397
CKL	IF(J.NE.'EDIT')GO TO 297
397	ISUB=6  
297	IF(ISUB.GT.4)GO TO 1773
	IF(J.EQ.ITMPO)GO TO 1773
CKL	IF(J.EQ.'CONDU')GO TO 1773
	IF(J.EQ.IPLAY)GO TO 1773
	IF(J.EQ.ISECTI)GO TO 1081
CKL	IF(J.EQ.'PLAY')GO TO 1773
CKL	IF(J.EQ.'SECTI')GO TO 1081
C******************  ABOVE AND BELOW FOR 'SECTIONS'
	IF(J.EQ.IEND)GO TO 1082
	IF(J.EQ.IFINI)GO TO 1082
CKL	IF(J.EQ.'END')GO TO 1082
CKL	IF(J.EQ.'END S')GO TO 1082
CKL	IF(J.EQ.'FINIS')GO TO 1082
362	INSNUM=NINS+1
	IF(INSNUM.GT.KZY)CALL ERR(7)
	INST(INSNUM)=J
	LETRS(INSNUM)=LLETRS
C  SAVE HOW MANY LETTERS IN INST. NAME (FOR 'RUNIT')
	IZ=INSNUM
	GO TO 1773

C*********** DOWN TO 8001 FOR 'SECTIONS'
1083	V(I)=-99.
	KL=1
	GO TO 3083
C  READS 'PLAY SECT. N1,N2'
1081	V(I)=-199.
	KL=4
3083	DO 2081 K=KL,72
C******  OR 80 ↑↑↑↑↑↑↑↑↑ ?????
	IF(INP(K).EQ.IBLA)GO TO 2081
	IV(I+1)=INP(K)
	I=I+2
3081	BY=-1.
	GO TO 2308
2081	CONTINUE
C   READS SECTION IDENTIFIER, -199. MARKS BEGINNING
1082	V(I)=-299.
	I=I+1
	GO TO 3081
C   MARKS END OF SECTION
C************************

8001	FORMAT(A5,5F)
107	FORMAT(I,A5,5F)
4	IF(INSNUM.LE.NINS)GO TO 8773
	IF(ALL.GT.0)GO TO 1004
	IF(IDALL.GT.0)GO TO 8773
	BG(INSNUM)=VX1
	IDALL=INSNUM
	GO TO 2004
C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
1004	BG(INSNUM)=VX1
	IF(INSNUM.EQ.IZ)VX1=0
C   MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
C   CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
2004	NINS=INSNUM
	IF(VX3.NE.0)VX2=10000.+VX3
	IF(VX2.EQ.0)VX2=-1
	DUR(INSNUM)=VX2
	GO TO 900
C******** ABOVE FOR REST ONLY ENTRIES.  FEB 18,71
8773	IF(VX2.EQ.0)GO TO 900
C 2 NUMBS HERE MEAN START ON NOTE NUM.VX2 OF INST.VX1
	IF(VX1.EQ.0)VX1=INSNUM
C VX1=0 MEANS USE NUMB. OF THIS INST.
	VX1=VX1*10000.+VX2
900	IF(VX1.NE.BY)GO TO 497
	IF(J.NE.IPLAY)GO TO 5773
CKL	IF(J.NE.'PLAY')GO TO 5773
C*********** 'PLAY' IS FOR 'SECTIONS'
497	BY=VX1
C  BY=CURRENT BG TIME.
	V(I)=-9900.-BY
	I=I+1
	IF(NWZ.NE.0)CALL BGSORT(BY)
5773	IF(JRSTA.EQ.0)GO TO 3173
	DO 173 K=NINS-1,1,-1
173	IF(JRSTA.EQ.INST(K))GO TO 1173
1173	VX1=K
	GO TO 7720
C GO DO A 'DUPL'
2173	JRSTA=0
3173	IF(J.EQ.ITMPO)GO TO 1106
CKL	IF(J.EQ.'CONDU')GO TO 3018
	IF(J.EQ.IPLAY)GO TO 1083
CKL	IF(J.EQ.'PLAY')GO TO 1083
C*********** ABOVE FOR 'SECTIONS'


4773	NW=LPAR
	ML=MLX
	IF(I.LT.KIMIT)GO TO 774
	TYPE 107,I
	IF(I.GE.LIMIT)TYPE 1774
1774	FORMAT(/' ******* TOO MUCH INPUT DATA!!   USE "MIXSCR" *******'/)
774	ALL=1.
	SUB=0
	ISUB=1

1299	IF(MLX.LE.LEND)GO TO 1773


7773	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
	IF(INP1.EQ.IBLA.OR.INP1.EQ.ILESS)GO TO 7773
C  ABOVE FOR COMMENTS.  BIG NUM = '<'
	IF(JED)GO TO 77733
	TYPE 2202 
	ACCEPT 77732,K
	CALL LO2UP(K)
	IF(K.NE.LY)GO TO 442
2203	FORMAT(' TYPE A LINE'/)
	TYPE 2203 
	ACCEPT 77732,JNP
442	IF(K.EQ.IG)JED=-1
C   DOESN'T WORK FOR EDITS AND INSERTS YET???


77733	MLX=1
C  FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
C   'LISTS' MUST END WITH ; IN NEW(7/74) VERSION. 
	CALL CLEAN(LEND)
1773	IF(IPRN.EQ.0)GO TO 17732
	L=I-1
	IF(QTS.GE.0)GO TO 597
	IF(V(I-1).EQ.999.)L=L-1
597	IPRN=IPRN-1
	IF(PARENS.EQ.0)GO TO 17733
	PARENS=0
	LIST(LCNT+2)=L
	LCNT=LCNT+3
	IF(IPRN.EQ.0)GO TO 17732
	IPRN=0
17733	LIST(MOT)=L
	MOT=0
C   FOR ERROR TRAP

CC17732	JZ=0
17732	N=0
17731	ML=MLX

C   BIG LOOP -- TO END OF PAGE 1.
	JPP=-1
C FOR OLD 'DF' STUFF.  CHECKS FOR A Pn
	JD=ML
975	N=INP(JD)
	IF(N.EQ.IBLA)GO TO 236
	IF(N.EQ.IPP)JPP=0
C FOUND  'P'
CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC.  CAN USE 26 LABELS.
33611	IF(N.EQ.LFTPAR)GO TO 697
	IF(N.NE.LRTPAR)GO TO 2361
697	INP(JD)=IBLA
	L=JD-1
5113	IF(INP(L).NE.IBLA)GO TO 2113
	L=L-1
	GO TO 5113
2113	IF(N.EQ.LRTPAR)GO TO 3361
	IF(PARENS.EQ.0)GO TO 1140
	LCNT=LCNT+3
	IF(MOT.NE.0)CALL ERR(3)
	MOT=LCNT-1
1140	DO 11401 JC=1,LCNT-1,3
	IF(INP(L).NE.LIST(JC))GO TO 11401
C  FINDS DUPLICATE IDENTIFIER
	TYPE 11402,INP(L)

11402	FORMAT(' ****** MOTIVIC (',A1,') USED TWICE')
11401	CONTINUE
	LIST(LCNT)=INP(L)
	PARENS=-1.
	INP(L)=IBLA
	LIST(LCNT+1)=I
	GO TO 236
C ''''''' FOR SINGLE QUOTES
3361	IPRN=IPRN+1
	GO TO 236
C  JUMPS BACK INTO QUOTE SECTION
C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
2361	IF(N.NE.':')GO TO 2362
	ICHD=ICHD+1
	N=KSLA
	GO TO 336

2362	IF(N.NE.IAT)GO TO 5361
	DO 113 L=1,LEND
	K=JD+L
C   K IS USED AT 240!!!
	JG=INP(K)
	IF(JG.NE.MINUS)GO TO 6113
	IF(CODE.EQ.-88.)CALL ERR(8)
	RETRO=0
	INP(K)=IBLA
	GO TO 113
6113	IF(JG.NE.LDOL)GO TO 7113
C  '$' IS FOR INVERSIONS IN 'NOTES'
	IF(CODE.EQ.-88.)CALL ERR(8)
	INVRT=0
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 JMOT=1,LCNT,3
	IF(JG.NE.LIST(JMOT))GO TO 6361
	VX1=0
	DO 40 M=JD+2,LEND
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
	IF(JG.EQ.KSLA)GO TO 140
	IF(JG.EQ.ISEMI)GO TO 140
	ML=M
	GO TO 240
40	CONTINUE
240	JC=JA
	JA=-1
	INP(K)=IBLA
	CALL SCANR
	JA=JC
140	JC=1
	KN=LIST(JMOT+1)
	M=LIST(JMOT+2)+1
	IF(RETRO)GO TO 640
	JC=M-1
	M=KN-1
	KN=JC
	JC=-1
	RETRO=-1.
640	IF(INVRT)GO TO 940
C INVERSIONS NEXT
840	X=V(KN)
	IF(X.GT.-9999.)GO TO 841
C CAN'T INVERT A 'P' NUMBER.
	Z=X
	GO TO 941
841	RB=X
	X=ABS(X)+VX1
	Z=X
	IF(RB)Z=-Z
941	V(I)=Z
C  FINDS CENTER FOR INVERSION (+TRANSP.)
	I=I+1
	IZ=IZ+1
C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
	KN=KN+JC
	IF(V(KN-JC).NE.199.)GO TO 940
C 199. IS NOW NUM. FOR 'R' (REST)  7/78
	V(I-1)=199.
	GO TO 840

940	Z=V(KN)
	IF(Z.LT.-9999.)GO TO 540
C CAN'T INVERT OR TRANSPOSE 'P' NUMBERS.
	IF(INVRT.EQ.0)GO TO 440
	IF(VX1.EQ.0)GO TO 540
C " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.(NO LIT)
	IF(CODE.EQ.-88.)CALL ERR(8)
	IF(CODE.EQ.-33.)GO TO 440
	V(I)=Z*VX1
	GO TO 7361
440	IF(Z.EQ.199.)GO TO 540
C 199. IS NOW NUM. FOR 'R' (REST)  7/78
	Y=0
	RB=VX1
	IF(Z)RB=-RB
	IF(INVRT)GO TO 541
	RB=-RB
	RC=X
C X IS SET FURTHER BACK.
	IF(Z)RC=-RC
C THIS STUFF FOR CHORD FEATURE
	Y=(RC-Z)*2
541	Z=Z+RB+Y
	Y=ABS(Z)
	IF(Y.LT.1.OR.Y.GT.108)CALL ERR(8)
C ERROR IF TRANSP. HAS PUSHED A NOTE NUMBER TOO HIGH OR TOO LOW.
	V(I)=Z
	GO TO 7361
540	V(I)=Z
7361	IF(JC.GT.0)GO TO 543
	IF(CODE.NE.-33)GO TO 543
	JG=I
	IF(V(I).GT.0)GO TO 543
542	Y=V(JG)
	V(JG)=V(JG-1)
	V(JG-1)=Y
C THIS STUFF FOR CHORD FEATURE
	IF(V(JG-2).GT.0)GO TO 543
	JG=JG-1
	GO TO 542
543	I=I+1
	IZ=IZ+1
C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	INVRT=-1
	RB=V(I-1)
	DO 8361 L=JD,LEND
	JG=INP(L)
	KN=L
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.LRTPAR)IPRN=IPRN+1
	IF(JG.NE.ISEMI)GO TO 8361
	IAMP=-1
	GO TO 9361
8361	CONTINUE
C  ABOVE 4 LINES PUT IN 8/76. REPLACE C***********  ↓↓

9361	MLX=L+1
	IF(L.GE.LEND)GO TO 93612
	IF(IAMP.NE.0)GO TO 797
	IF(QTS)GO TO 1773
C  GO BACK IF NOT END OF LINE
797	JZ=-1
93612	IF(IAMP.EQ.0)GO TO 93611
	IF(QTS)GO TO 9004
	GO TO 2722
C  THESE ARE FOR "LIT" ITEMS
C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
C  NO $ WITH FUNC.  $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
93611	IF(KN.EQ.LEND)GO TO 7773
	JZ=0
	IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
	GO TO 236
C  LAST TIME FOR QUOTES

C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
C   JUMPS TO END STRING OF QUOTES
6361	CONTINUE
	CALL ERR(0)
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(N.EQ.LDOL)CALL ERR(8)
C  FOUND $  BUT NO @!
	INPX=INP(JD+1)
53611	IF(N.NE.ISS)GO TO 53612
	IF(INPX.NE.LU)GO TO 53612
	SUB=SUB-200
C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
	GO TO 43615
53612	IF(N.NE.IEM)GO TO 612
	IF(INPX.NE.III)GO TO 612
	SUB=SUB-200.5
C  THE '.5' CALLS 'MICRO' RATHER THAN 'SUBR'.
	GO TO 43615
612	IF(N.NE.IAA)GO TO 43611
C   FINDS 'ALL'.
	IF(INPX.NE.IEL)GO TO 236
	ALL=-1.
	GO TO 43615
C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.

C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
C   BEFORE! QUAD (IF USED).
C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
43611	IF(N.NE.LQ)GO TO 4361
	IF(INPX.NE.LU)GO TO 4361
	QX=-13.
	DO 43612 N=JD,LEND
	J=INP(N)
	IF(J.EQ.IXX)QX=QX-1.
	IF(J.EQ.IF)QX=QX-2.
	IF(J.EQ.IBLA)GO TO 236
	IF(J.EQ.KSLA)GO TO 236
43612	INP(N)=IBLA
4361	IF(N.NE.III)GO TO 43613
	IF(ISUB.NE.4)GO TO 43613
C  -1= 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
C  -2= 'NM IE' MAKES 'END' OF PRINTOUT INVIS. ( ;PRINT(P1)--ETC.)
C  -3= BOTH BEGINNING AND END ARE INVIS.
C  THIS IS SO PARAMS MAY BE EXTENDED TO 58 ON TO A DUMMY INST.
	L=-1
	IF(INPX.EQ.IE)L=L-1
	INVIS(INSNUM)=INVIS(INSNUM)+L
43615	DO 43614 L=JD,LEND
	N=INP(L)
	IF(N.EQ.IBLA)GO TO 236
	IF(N.EQ.ISEMI)GO TO 236
43614	INP(L)=IBLA
43613	IF(N.NE.KSLA)GO TO 1336
	IF(JD.GE.LEND-1)JZ=0
C  SO IT WILL READ NEXT LINE.
	GO TO 336
1336	IF(N.NE.ISEMI)GO TO 936
	IAMP=-1
336	MLX=JD+1
	IF(ISUB.GE.104)GO TO 104
	IF(ISUB.GT.3)GO TO 1899
   	GO TO (101,102,103),ISUB
C             PAR  MOV LIST  OTHERS
936	IF(N.NE.IDOT)GO TO 136
	L=INP(JD+1)
	DO 836 KL=1,10
836	IF(L.EQ.IDAT(KL))GO TO 236
	IF(CODE.EQ.-22..OR.CODE.EQ.-23.)INP(JD)=1
	GO TO 236
136	IF(N.NE.IQT)GO TO 236
	DO 1361 K=JD+1,LEND
	IF(INP(K).NE.IQT)GO TO 1361
	JD=K+1
	GO TO 975
C   SKIPS MATERIAL IN QUOTES
1361	CONTINUE
	CALL ERR(0)
C   OPEN QUOTES
236	JD=JD+1
	IF(JD.LE.LEND)GO TO 975
	CALL ERR(1)
1899	CALL SCANR
	GO TO(1,2,3,4,5,6),ISUB
101	N=INP(ML)
	IZ=ML
	ML=ML+1
	IF(N.EQ.IBLA)GO TO 101
	M=1
	JA=-1
C AT THIS POINT IT LOOKS FOR P=PARM, E=END, D=DUPL, C=CONTINUATION, R=RUN.
	IF(N.EQ.IPP)GO TO 1
	IF(N.EQ.IE)GO TO 2308
	IF(N.NE.LR)GO TO 1101
	N=INP(ML)
C   'RUN' MAY REPLACE 'END' FOR LAST INST.
	IF(N.EQ.LU)CALL RUNIT
	LPAR=1
C TYPE 'RD' (P1) FOR RANDOM DEVIATION, 'RR'(P100) FOR RANDOM RESTS.
	IF(N.NE.LR)LPAR=NUMP+1
1205	K=ML  
205	K=K+1 
	IJ=INP(K)
	IF(IJ.EQ.IBLA)GO TO 205
	IF(IJ.NE.IDOT.AND.IJ.NE.MINUS.AND.
	1 IJ.NE.IPP.AND.(IJ.LT.IZERO.OR.IJ.GT.NINE))CALL ERR(0)
C LOOK FOR ILLEGAL FORMAT WITH RR, RD, DF. (ACCEPTS NUM,DOT,Pn,MINUS)
	GO TO 201
1101	IF(N.NE.ID)GO TO 303 
	IF(INP(ML).NE.IF)GO TO 7720
C NEXT FOR 'DF' DUTY FACTOR IN PLACE OF A Pn.  (TAKE OUT OLD DF STUFF LATER.)
C IEM IS USED AFTER 897 INSTEAD OF 'ML'
	LPAR=NUMP+2
C USE P101 FOR DF.
	GO TO 1205
303	IF(N.NE.ICC)CALL ERR(0)
C NEXT FOR 'CONTINUATION'.  AUTOMATICALLY PUSHES UP PARAM NUMS.
	IOFSET=IOFSET+1
	LPAR=IOLDPR+IOFSET
	TYPE 1201,IOFSET
	IF(LPAR.GT.NUMP)CALL ERR(6)
2201	IF(INP(ML).EQ.IBLA)GO TO 3201
C  TO MOVE POINTER AHEAD.  MUST HAVE BLANK AFTER ICC OR 'CO' OR 'CONT', ETC.
	ML=ML+1
	GO TO 2201
3201	IZ=ML-1
	M=0
	GO TO 201
1201	FORMAT(' →→→→→→ REMEMBER →→→→→ PARAMETER OFFSET=',I2)

1	CALL SCANR
	IOLDPR=VX1
C SAVE PARAM NUM. FOR POSSIBLE 'CONTINUATION'.  BEWARE OF >P30!!!!
	LPAR=IOLDPR
C*******	IF(LPAR.GT.30)GO TO 201
	IF(LPAR.GT.NUMP)GO TO 201
	LPAR=LPAR+IOFSET
	IF(LPAR.GT.NUMP)CALL ERR(6)
C*******	IF(LPAR.GT.30)CALL ERR(6)
201	IJ=LPAR
	IF(IJ.GT.NUMP+2)CALL ERR(6)
C**************	IF(IJ.GT.32)CALL ERR(6)
CATCHES PARAM. OUT OF RANGE.
	IF(QX.GE.0)GO TO 5703
	IJ=LPAR+4
C  SETS UP PARAM FOR QUAD CALL
	V(I)=IJ+INSNUM*10000
	V(I+1)=2*ALL
C  TEST "ALL" FEATURE HERE!!!!!!!
C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
	V(I+2)=QX
	I=I+3
	QX=0.
5703	IAMP=0
	IF(IJ.LE.NP(INSNUM))GO TO 897
	IF(IJ.LE.NUMP)NP(INSNUM)=IJ
897	V(I)=LPAR+INSNUM*10000
C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
	IJ=I+1
	I=I+4
	ITMP=0
	CODE=0
	NFLG=1
	ML=IZ+M
C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
C  QU=QUADC  QUX=QUADX 
5702	ML=ML+1
CC	IF(ML.GT.72)GO TO 99
	N=INP(ML)
	IF(N.EQ.IBLA)GO TO 5702
	IF(N.EQ.ICOM)GO TO 5702
	NL=INP(ML+1)
	JA=-1
	ISUB=0
	IF(N.EQ.IXX)GO TO 2703
	IF(N.EQ.LR)GO TO 6702
	IF(N.EQ.IF)GO TO 8702
	IF(N.EQ.IPP)GO TO 7006
	IF(N.EQ.ID)GO TO 3702
	IF(N.NE.ICC)GO TO 4005
	IF(NL.EQ.LU)GO TO 7006
C  FOR 'CUTOFF'
4005	JA=0
	IF(N.EQ.IEN)GO TO 6005
	IF(N.EQ.IEM)GO TO 703
	IF(N.EQ.IEL)GO TO 2720
	IF(N.EQ.ISS)GO TO 6703
CKL	IF(N.EQ.ITT)GO TO 4018
	IF(N.EQ.IQT)GO TO 5720
	IF(N.EQ.ISEMI)GO TO 2018
C 7/75	IF(N.EQ.IPP)JA=-1
C  FOR ;P5  P3;
7006	CALL SCANR
	IF(ISUB.EQ.8)GO TO 8
	I=I+JJ
	V(IJ+1)=NNUM+SUB
	IF(JJ.EQ.1)GO TO 4006
C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
	IF(NNUM.NE.-2)GO TO 5006
	IX=IJ+3
	DO 2006 K=2,JJ,3
2006  CALL RANR(VX,K)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
5006	IX=IJ+2
	DO 6006 K=1,JJ
6006	V(IX+K)=VX(K)
	IF(NL.EQ.LU)GO TO 8006
C  JUMP FOR 'CUTOFF'
	IF(MOD(JJ,3).NE.0)CALL ERR(12)
	V(IX+JJ-2)=1.
C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
	GO TO 3013
CCCC NOW DONE IN 'SCANR' 7/78   4006	IF(JA)VX1=-VX1/100.-9999.
C  CHANGES ;P5 P3; TO ;P5 -9999.03; ***** CHECK OUT ON OTHER MACHINES!
CIRC4006	IF(JA)VX1=VX1/100.+9999.
CIRC  CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
4006	V(I-1)=VX1
	GO TO 3013
8006	V(IJ+1)=-19
C  FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
	GO TO 3013
6702	IF(NL.EQ.IE)GO TO 2703
C   JUMP IF "REP"
CKL	IF(NL.EQ.ITT)GO TO 4018
C   JUMP IF "RTAP"
	IF(NL.EQ.LR)GO TO 702
C RR=RAN. RESTS
	IF(NL.EQ.ID)GO TO 1702
C RD=RAN. DEV. OF P1
	CODE=-22
	IF(NL.EQ.IEL)CODE=-46.0
C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
	IF(NL.NE.IEN)GO TO 1016
C   JUMP IF NOT "RNOTES"
	JA=0
C   FOR SCANR
	CODE=-36.
	GO TO 1016
702	K=100 
C PARAM CODE FOR RAN. RESTS
	GO TO 2702
1702	K=1
C PARAM CODE FOR RAN. DEV.
	GO TO 2702
3702	IF(NL.NE.IF)GO TO 4005
	K=101 
C PARAM CODE FOR DUTY FAC. 
2702	V(I+1)=V(I-4)
C  SHIFT STUFF AROUND
	V(I-4)=INSNUM*10000+K
	V(I-3)=4.
	V(I-2)=-1.
	V(I-1)=1.
	V(I)=-9999.0-LPAR/100.0
	I=I+5
	IJ=IJ+5
	ML=ML+1
	GO TO 5702
6005	CODE=-33
	IF(NL.EQ.IAA)GO TO 2721
C  NUMS, NOTES, NAMES.
	IF(NL.NE.LU)GO TO 1016
	CODE=-44.
1610	JA=-1
	GO TO 1016
8702	CODE=-35
	IF(NL.EQ.LU)GO TO 1016
	ML=ML+1
	CALL SCANR
7	V(IJ+1)=CODE+SUB
	V(IJ+2)=1.
	IF(VX1.GT.99)CALL ERR(4) 
C TRAPS F NUMS >99.
	V(I)=VX1+200.
	GO TO 7703
C********  MOVE IS NEXT ***********
703	BW=V(IJ-2)
	IC=0
	DO 7031 K=ML+1,LEND
	LP=INP(K)
	IF(LP.EQ.KSLA)GO TO 8031
	IF(LP.EQ.IPP)IC=1
C 'MOVP' P7 MOVP/10 3,4.9 5,5.9;MOVES FROM RAN SEL. OF P3,P4 TO P5,P5.
7031	IF(LP.EQ.IXX)IC=-1
C   IC=-1 IS FOR MOVX, IC=0 FOR MOVE, IC=1 FOR MOVP.
8031	I=I-1
	V(I)=0
	X=-9900.-BY
	IF(BY.EQ.0)X=-9900.-BG(INSNUM)
   	IF(BW.EQ.X)GO TO 8005
	IF(BW.NE.-9900.-BY)GO TO 1102
	V(IJ-2)=X
	GO TO 8005
1102	V(IJ)=V(IJ-1)
	V(IJ-1)=X
	IJ=IJ+1
	I=I+1
8005	LP=IJ-1
	BW=-9900.-X
	ISUB=2
	IZ=-1
C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
4703	GO TO 1299
102	IF(IZ.LT.0)GO TO 2102
C  SKIPS NEXT FIRST TIME
	BW=V(ICT)+BW
	V(I)=-9900.-BW
	V(I+1)=V(LP)
	V(I+2)=(JJ+2)*ALL
	V(I+3)=CODE+SUB
	I=I+4
	IZ=1
2102	IF(BW.LT.10000.)CALL BGSORT(BW)
C   ROUND-OFF NONSENSE
2	VX3=-9900.
	VX2=VX3 
	CALL SCANR
	IF(JJ.GT.0)GO TO 5102
	JJ=ILIT
C SLASH WILL REPEAT MOVE INPUT -- 6/74
	DO 6102 K=1,JJ
6102	VX(K)=VX(K+20)
	GO TO 5005
C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
5102	IF(JJ.EQ.4)CALL ERR(9)
C  ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
	IF(VX3.NE.-9900.)GO TO 3102
	IF(VX2.NE.-9900.)GO TO 4102
	VX2=VX1
	VX1=10000.
4102	VX3=VX2
	JJ=3
C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102	IF(IZ.GE.0)GO TO 3006
	V(IJ)=(JJ+2)*ALL
C  WORD COUNT
	CODE=-55.
	IF(JJ.NE.3)CODE=-57.
	IF(NFLG)CODE=CODE-1.
	IF(IC)CODE=-59.
C  CODE=-56 OR -58 FOR NOTES.
	V(IJ+1)=CODE+SUB
	IZ=0
3006	IF(NFLG.EQ.1)GO TO 5005
	CALL RANR(VX,2)
      IF(JJ.NE.3)CALL RANR(VX,4)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
5005	IF(IC.LE.0)GO TO 3003
C NEXT FOR 'MOVP',  MOVE FROM PARAM TO PARAM.
	DO 1003 K=2,JJ
1003	VX(K)=-VX(K)/100.0-19999.0
C  CHANGES PARAM NUMS TO MAGIC NUMS.
3003	ICT=I
	ILIT=JJ
C  SAVES FOR SLASH REPEAT FEATURE
  	IJ=IJ+1
	DO 1006 K=1,JJ
	VX(20+K)=VX(K)
C  SAVES FOR SLASH REPEAT FEATURE
1006	V(IJ+K)=VX(K)
	I=I+JJ  
	IJ=I+2
	IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
	V(I)=-9900.-BY
	GO TO 8703

7703	V(IJ)=4.*ALL
8703	I=I+1
	GO TO 4773
C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
6703	CODE=-12.
	IF(INP(ML+3).EQ.IEL)CODE=-11.
	V(IJ)=2.*ALL
	V(IJ+1)=CODE+SUB
	I=I-1
	GO TO 4773
CKL4018	CNT(INSNUM)=-9900.-BY
CKL	P(INSNUM)=V(I-4)
CC 6/74 COLGATE 	JREAD=3
CC 6/74 COLGATE	GO TO 4400
CKL1444	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
CKL443	IF(LN.NE.0)REREAD 107,K,IPT(INSNUM,1)
CKL	IF(LN.EQ.0)REREAD 8001,IPT(INSNUM,1)
C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
CKL	IF(J.EQ.'CONDU')GO TO 444
CKL	IF(NL.NE.ITT)GO TO 2338
CKL	CODE=-23.
CKL	GO  TO 1016
CKL2338	I=I-4
CKL	GO TO 4773
CKL3018	CNT(KZY)=-9900.
CKL	INSNUM=KZY
C TO PUT 'CONDUCT' FILE NAME IN LAST SLOT (KZY) AT 443
CKL	GO TO 1444
CKL444	P(KZY)=980000.
CKL	GO TO 2308
C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
C  'REP'
2703	ML=ML+1
	VX1=0
	VX2=0
	VX3=0
	IF(N.EQ.IXX)GO TO 2704
	INP(ML)=IBLA
	INP(ML+1)=IBLA
C  WIPES OUT 'EP' IN 'REP'
2704	CALL SCANR
 	V(IJ)=3.
	V(IJ+1)=-66.0
	IF(VX1.EQ.32.)VX1=1.
	IF(VX1.EQ.0)VX1=LPAR
	IF(VX2.EQ.0)VX2=INSNUM-1
	V(IJ+2)=VX1+VX2*10000.
	KL=VX2
	IF(DUR(INSNUM).LT.0)DUR(INSNUM)=DUR(KL)
	IF(VX3.EQ.0)GO TO 4773
	L=VX3
	ML=INSNUM+1
	DO 1018 KL=ML,L
	IF(LPAR.LE.NP(KL))GO TO 997
	IF(LPAR.LT.31)NP(KL)=LPAR
997	IF(DUR(KL))DUR(KL)=DUR(INSNUM)
C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
	V(I)=V(I-4)+10000.
	V(I+1)=3.
	V(I+2)=-66.
	V(I+3)=V(I-1)
1018	I=I+4
	GO TO 4773

2018	IF(SUB.EQ.0)GO TO 20181
C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
	V(IJ+1)=-201.
	V(IJ+2)=1.
	V(IJ+3)=0
	GO TO 7703
20181	V(IJ)=3.
	V(IJ+1)=-66.
	V(IJ+2)=NW+INSNUM*10000
	GO TO 4773
C  READS /P5  .3 "ABC" .7 "XYZ"/

8 	IF(MOD(JJ,2).NE.0)CALL ERR(12)
	IF(LPAR.EQ.2)CALL ERR(13)
	V(IJ+1)=-77.+SUB
C  SUB HAS SUBR CALL INFO
	I=I+1
	VX(JJ-1)=1
C  FOR RAND. SINGLE LITS.
	DO 3722 K=1,JJ,2
	V(I)=VX(K)
3722	I=I+1
	V(IJ+2)=JJ/2
	V(IJ+3)=I
	DO 4722 K=2,JJ,2
	KN=I
	I=I+1
	L=VX(K)
	DO 6722 KL=L,LEND
	IF(INP(KL).EQ.IQT)GO TO 4722
	IV(I)=INP(KL)
6722	I=I+1
4722	V(KN)=I-KN-1
	V(IJ)=(I-IJ)*ALL
	GO TO 4773
2720	QTS=0
2721	ISUB=104
	IF(NL.EQ.IAA)ISUB=ISUB+1
	GO TO 1299

104	IF(ISUB.EQ.104)GO TO 1041
C NEXT FOR INST NAME CHANGES.  Pn NAMES/N;
C  V LIST= n000n/WDCNT/-89/NUM OF DUPLS/INST NAME/NUM OF LETTERS IN NAME/
C  *********** NO 'ALL' OR 'DUPL' FEATURES WITH NAMES **************
	V(IJ)=5
	V(IJ+1)=-89
	CALL SCANR
	V(I-1)=VX1
	IV(I)=INST(INSNUM)
CXX	IV(I+1)=2**(1+(7-LETRS)*7)
	I=I+2
	GO TO 4773
1041	KL=0
	CODE=-88.
	DO 6721 K=ML,LEND
	L=INP(K)
	IF(L.EQ.IBLA)GO TO 6721
	JC=K+1
	IF(L.EQ.IQT)GO TO 7721
	IF(L.EQ.KSLA)GO TO 7232
	IF(L.EQ.ISEMI)GO TO 7232
	IF(L.NE.IF)GO TO 1040
	IF(INP(K+1).NE.III)GO TO 1040
	IF(INP(K+2).NE.IEN)GO TO 1040
	IF(INP(K+3).NE.IE)GO TO 1040
C FINDS THE WORD "FINE".
	V(I)=-10000.
	IF(DUR(INSNUM))DUR(INSNUM)=10000
	GO TO 1042
1040	IF(L.EQ.IPERC)INP(K)=KSLA
	IF(L.EQ.IQUES)INP(K)=ISEMI
	IF(L.EQ.IEXP)INP(K)=ICOM
	IF(L.EQ.INUM)INP(K)=ILESS
	IF(L.EQ.IANPRS)INP(K)=IDBLQ
C  THE ABOVE ARE ALL SPECIAL CHAR'S TO AVOID VARIOUS CONFUSIONS.
	IF(KL.EQ.0)KL=K
6721	CONTINUE
C  FOR REPEAT OF ITEM BY SLASH
C  KL IS START OF QUOTE, THEN K IS END -- WHEN NO "S ARE USED.
7232	IF(KL.EQ.0)GO TO 7233
	JC=KL
	ML=K+1
	JD=K-1
	NLIT=K-KL
	GO TO 8721

7233	DO 7230 KL=ILIT,ILIT+NLIT
	V(I)=V(KL)
7230	I=I+1
	GO TO 27222
7231	CONTINUE

5720	IAMP=-1
	JC=ML+1
C  FOR SINGLE 'LIT' ITEMS.
7721	DO 1722 KL=JC+1,LEND
	IF(INP(KL).NE.IQT)GO TO 1722
	JD=KL-1
	ML=KL+1
	NLIT=KL-JC
C   EXTENT OF LIT ITEM IS FOUND
	GO TO 8721
1722	CONTINUE
C  CAN'T USE SLASH FOR REPEAT AFTER @Q
8721	V(I)=NLIT
	ILIT=I
	DO 9721 K=JC,JD
C   PUTS ITEM IN "IV" ARRAY
	I=I+1
9721	IV(I)=INP(K)
	I=I+1
27222	IF(IAMP.EQ.0)GO TO 1299
2722	V(I)=999.
1042	QTS=-1.
	CODE=-88.
C 105, -89. FOR LIST OF NAMES FOR INST. NAME CHNGS.
	IF(LPAR.EQ.2)CALL ERR(13)
C NO 'LIT' WITH P2!!
	V(IJ+1)=CODE+SUB
	V(IJ)=(I-IJ+1)*ALL
	IJ=IJ+2
	V(IJ)=IJ+1
	I=I+1
	ISUB=1
	GO TO 1299

7720	V(I)=INSNUM
	V(I+1)=3.
	V(I+2)=-67.
	ML=ML+4
	IF(JRSTA.EQ.0)CALL SCANR
	IF(VX1.EQ.0)VX1=INSNUM-1
C DUPL 0; = DUPL PREV. INST. NUM
 	V(I+3)=VX1
	I=I+4
	L=VX1
	IF(NP(INSNUM).LT.NP(L))NP(INSNUM)=NP(L)
	IF(JRSTA.NE.0)GO TO 2173
C GO BACK IF THIS WAS AN AUTOMATIC 'DUPL' WITH A 'RESTART' (DUR IS DIFFERENT)
	IF(DUR(INSNUM).LT.0)DUR(INSNUM)=DUR(L)
CXXXXXXX	IF(JRSTA.NE.0)GO TO 2173
CXXXXXXXC GO BACK IF THIS WAS AN AUTOMATIC 'DUPL' WITH A 'RESTART'
	GO TO 4773
C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
142	FORMAT(I,15A5) 
1301	FORMAT(15A5) 
1302	FORMAT(1X15A5) 
300	FORMAT(I,3F,A1)
301	FORMAT(3F,A1)
6	IF(J.NE.'PRECE')GO TO 1341
C  'PRECEDE' WRITES LINES DIRECTLY ON DSK, BEFORE THE WORD 'PLAY;'.
C  NO LIMIT TO THE NUMBER OF LINES.  LAST LINE (NOT PRINTED) MUST 
C  BEGIN WITH *.     KNP ARRAY (15) IS EQUIV. TO INP .
4341	IF(ITYP)GO TO 5341
	TYPE 2203 
	ACCEPT 1301,KNP
	CALL SHORT(KNP,K)
	WRITE(21,1301)(KNP(JD),JD=1,K)
	GO TO 6341
5341	IF(LN.EQ.0)GO TO 2341
	READ(23,142,END=7341)K,KNP
	GO TO 3341
7341	CALL ERR(10)
C   GO TO ERROR ROUTINE IF MISSING "*".
	STOP
2341	READ(23,1301,END=7341)KNP
3341	CALL SHORT(KNP,K)
C  DON'T TYPE TRAILING BLANKS
	IF(MX.EQ.22)GO TO 6341
	IF(SOS)TYPE 1302,(KNP(JD),JD=1,K)
6341	IF(MX.EQ.22)WRITE(JOUT,1302)(KNP(JD),JD=1,K)
	IF(KNP(1).EQ.IASTR)GO TO 2308
	IF(MX)WRITE(1,1301)(KNP(JD),JD=1,K)
	GO TO 4341
1341	KB=KB+1
	IF(JED.GT.0)JED=0
	IF(J.EQ.'INSER')GO TO 1340
	OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
	GO TO 340   
1340	X=VX1
	IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
	OTH(KB,1)=X
	GO TO 1338
C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
C   - BEGIN LINE WITH  <,END WITH ; 
C   UP TO 75 CHARACTERS MAY BE TYPED.     
340      IF(VX3.NE.2)GO TO 1338 
	IF(ITYP.GE.0)GO TO 449
CC	JREAD=5
CC 6/74  COLGATE	GO TO 4400
	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
445	OTH(KB,3)=1.
CC	IF(IFI.GE.0)GO TO 447
	IF(LN.EQ.0)GO TO 447
	REREAD 300,K,OTH(KB,2)
	GO TO 1447
447	REREAD 301,OTH(KB,2)
1447	IF(JED)GO TO 2308
3445	TYPE 2202 
	ACCEPT 77732,K
	CALL LO2UP(K)
	IF(K.EQ.IG)JED=-1
	IF(J.EQ.'INSER')GO TO 3446
	IF(K.NE.'Y')GO TO 2308
	IF(JED)GO TO 2308
449	TYPE 2203 
	ACCEPT 301,OTH(KB,2)
	IF(JED)WRITE(21,301) OTH(KB,2)
	GO TO 2308

1338	IF(ITYP.GE.0)GO TO 1449
CC	JREAD=6
CC 6/74 COLGATE	GO TO 4400
	IF(READER(JNP))CALL RUNIT
C  READS A LINE.  IF END OF FILE, JUMPS.
446	IF(LN.EQ.0)GO TO 448
	REREAD 142,K,(OTH(KB,JD),JD=2,16)    
	GO TO 1446
448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
1446	IF(JED)2446,3445,2446
3446	IF(K.NE.LY)GO TO 2446
	IF(JED)GO TO 2446
1449	TYPE 2203 
	ACCEPT 1301,(OTH(KB,JD),JD=2,16)
	IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
2446	X=OTH(KB,2)
	IF(J.NE.INSER)GO TO 971
	IF(VX3.EQ.0)GO TO 971
	IF(X.NE.ASTR)GO TO 6
971	IF(X.EQ.ASTR)KB=KB-1
C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
C   LAST LINE HAS '*' IN COLUMN 1.
	GO TO 2308
C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
C   BX=INST N. Y=NOTE N. Z=PARAM N. 
1106	KTMP=1
	IAMP=0
	BW=BY
	ITMP=-1
	ISUB=5
	JA=-1
	GO TO 2016
3019	V(I)=990000.00
	V(I+1)=4.
	V(I+2)=VX1
	V(I+3)=VX2
	V(I+4)=VX3
	I=I+5
	BY=BW
	IF(VX1.EQ.0)GO TO 2308
	BW=BW+VX1
	V(I)=-9900.-BW
	I=I+1
	CALL BGSORT(BW)
9003	IF(IAMP)GO TO 4003
2016	VX3=0
	VX2=0
	GO TO 1299
5	IF(VX2.NE.0)GO TO 105
C  'TEMPO/120;'  OR  'TEMPO/1.5 72;'  IS OK.
	VX2=VX1
	VX1=0
105	IF(VX2.GE.12.)VX2=VX2/60.
C TEMPO < 12 = A FACTOR, ≥12 = MM. NUM.
   	IF(VX3.GE.12.)VX3=VX3/60.
	IF(VX3.EQ.0)VX3=VX2
	IF(J.EQ.ITMPO)GO TO 3019
  	PCH(1,KTMP)=VX1
	PCH(2,KTMP)=VX2
	PCH(3,KTMP)=VX3
C   PCH(1)=TIME  (2)=MM1  (3)=MM2
	KTMP=KTMP+1
	IF(IAMP.EQ.0)GO TO 2016
4003	VX1=0
	IAMP=0
	VX2=VX3
	IF(J.EQ.ITMPO)GO TO 3019
	PCH(1,KTMP)=0
	PCH(2,KTMP)=VX2
	PCH(3,KTMP)=VX2
C   MM CAN BE FROM 11 UP  TEMPO FACTOR FROM 10 DOWN.  
C   UP TO 30 TEMPO CHANGES MAY BE MADE.   

1016      IA=I    
      IZ=1  
3100	V(I-2)=CODE+SUB
      ISUB=3     
5016	IF(IAMP.GE.0)GO TO 1299
117	IF(IZ-2)3013,9004,9004
103	K=INP(ML)
	IF(K.EQ.ITT)GO TO 1106
	IF(K.EQ.KSLA)GO TO 1014
	IF(K.EQ.ISEMI)GO TO 1014
1010	IF(K.NE.IBLA) GO TO 1899
1011	ML=ML+1
	GO TO 103
3	IF(VX1.EQ.-99.)GO TO 4022
	IF(CODE.EQ.-22.)GO TO 2017
  	IF(CODE.LT.-23)GO TO 17
	IF(IZ/2*2.EQ.IZ)GO TO 17
C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
2017	IF(VX1.LT.-9999.)GO TO 3017
      	IF(VX1.NE.0)VX1=4./VX1
C RHYTHMIC INPUT OF 0 GIVES 0 DURATION REST!!!
	IF(JJ.NE.1)GO TO 2014
3017	V(I)=VX1
	GO TO 114

1217	IF(VX1.EQ.-10000.)GO TO 114
C    FOR "FINE" IN LIST
      V(I+1)=VX2
      IF(CODE.EQ.-36.)CALL RANR(V,I)
2217	I=I+1
C  SETS UP STRING OF RAND SELECTIONS
	GO TO 114
3217	V(I)=V(I-2)
	V(I+1)=RB
C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
	GO TO 2217
C******** PUT IN ERROR TRAP FOR "REP" ETC. ******

2014	DO 9006 L=2,JJ
	IF(VX(L).EQ.0)GO TO 17
9006	VX1=4./VX(L)+VX1
	JJ=1
17  	IF(ICHD.EQ.0)GO TO 4014
	JJ=1
C  SETS UP NEXT NOTE AS CHORD (THIS ONE BECOMES NEG.)
	VX1=-VX1
C  FOR CHORD FEATURE
	ICHD=0
4014	V(I)=VX1
	IF(CODE.EQ.-46.)GO TO 1217
	IF(CODE.EQ.-36.)GO TO 1217
	IF(CODE.NE.-35)GO TO 972
C****************** 8/78	IF(VX1.GT.15)CALL ERR(4)
C  FINDS F NUM.>15!
C  JUMP IF STRING OF RAND SELECS.
972	IF(JJ.EQ.1)GO TO 114
	L=VX(JJ)-1
	X=V(I)
	NL=I+1
	I=L+I
	DO 1017 K=NL,I
1017	V(K)=X
C   ADDS UP TOTAL   OF NOTES IN SEQ.
	IZ=IZ+L
	GO TO 114
1014	IF(CODE.EQ.-46.)GO TO 3217
	IF(CODE.EQ.-36.)GO TO 3217
	IF(CODE.NE.-33)GO TO 1103
	IF(V(I-2).GE.0)GO TO 1103
C NEXT FOR SLASH REPEAT OF CHORD
	JC=1
	JD=1
	GO TO 2103
1103	V(I)=RB
C   RB SAVES IT FOR SLASH REPEAT
114      RB=V(I)     
      I=I+1 
      IZ=IZ+1     
      GO TO 5016    
4022	JC=VX2+.3
	JD=VX3-.5
	IF(JJ.EQ.2)JD=1
C********* MAY 19,71   ----MANY LINES ABOVE.
2103	IZ=IZ+JC*JD 
C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
	IF(CODE.NE.-33)GO TO 3103
8103	N=0
	V(IA-1)=0
	DO 4103 K=I-1,1,-1
	IF(V(K).GE.0)GO TO 7103
	IF(V(K).GT.-9999.0)GO TO 4103
C NEG. NUMBS USUALLY ARE CHORD NOTES,   -9999.N IS SECONDARY PARAM.
7103	N=N+1
4103	IF(N.EQ.JC)GO TO 5103
5103	IF(V(K-1).GE.0)GO TO 6103
	IF(V(K).EQ.0)GO TO 6103
	K=K-1
	GO TO 5103
6103	JC=I-K

3103	DO 1005 K=1,JD    
	NL=I+JC-1  
	DO 2005 L=I,NL    
2005  V(L)=V(L-JC)
1005      I=I+JC  
	RB=V(NL)
C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
      GO TO 5016  

9004	IF(ITMP.EQ.0)GO TO 3013
	IZ=IZ-1
      KA=1  
      IC=1  
      K=0   
	J=1
      Z=0   
      RC=0  
9007	Y=PCH(3,IC)
	X=PCH(2,IC)
      Z=PCH(1,IC) 
	CALL SQYY(YY,X,Y,Z)
	XT(1)=X
      PR=RA 
      ZZ=Z  
      CALL ACCEL
      IF(K.EQ.IZ)GO TO 3013
	IF(RA.NE.-10000.)GO TO 9007     
3013	X=I-IJ
	V(IJ+2)=X-3.
	V(IJ)=X*ALL
	IF(CODE.NE.-35)GO TO 4773
	M=IJ+3
C   SETS NUMBERS FOR FUNCS.
	DO 313 K=M,I-1
	X=V(K)
	IF(X.LT.-9999.)GO TO 313
CATCHES 'FINE'(-10000), F1-F99 ONLY PLEASE. USE  NEG. FOR REST IN FUNC LIST.
	V(K)=X+200.
	IF(X.LT.0)V(K)=199.
313	CONTINUE
	GO TO 4773

	END